Priors
\(\alpha\)
tibble(x = seq(0, 1.3, length = 10^(5)),
y = with(prior_params, gamma_density(x,
mean = alpha_mean,
sd = alpha_sd,
bounds = alpha_bounds))) %>%
ggplot(aes(x=x, y = y)) +
geom_line(alpha = .8) +
geom_ribbon(aes(x=x,ymin=0,ymax=y),
fill="black",
alpha=.6) +
theme_c(legend.text=element_text(size = 10)) +
viridis::scale_fill_viridis(discrete=TRUE,
option = "rocket", begin=.3,end=.8) +
labs(x = "Value",
y = "Probability Density",
title = latex2exp::TeX("Definition of Prior for $\\alpha$"),
fill ='',
subtitle = paste0("Mean: ", prior_params$alpha_mean,
", SD: ", prior_params$alpha_sd))
\(\beta\)
tibble(x = seq(0, 1, length = 10^(5)),
y = with(prior_params, beta_density(x,
mean = beta_mean,
sd = beta_sd,
bounds = beta_bounds))) %>%
ggplot(aes(x=x, y = y)) +
geom_line(alpha = .8) +
geom_ribbon(aes(x=x,ymin=0,ymax=y),
fill="black",
alpha=.6) +
theme_c(legend.text=element_text(size = 10)) +
viridis::scale_fill_viridis(discrete=TRUE,
option = "rocket", begin=.3,end=.8) +
labs(x = "Value",
y = "Probability Density",
title = latex2exp::TeX("Definition of Prior for $\\beta$"),
fill ='',
subtitle = paste0("Mean: ", prior_params$beta_mean,
", SD: ", prior_params$beta_sd))
\(P(S_1|\text{untested})\)
tibble(x = seq(0, 1, length = 10^(5)),
y = with(prior_params, beta_density(x,
mean = s_untested_mean,
sd = s_untested_sd,
bounds = s_untested_bounds))) %>%
ggplot(aes(x=x, y = y)) +
geom_line(alpha = .8) +
geom_ribbon(aes(x=x,ymin=0,ymax=y),
fill="black",
alpha=.6) +
theme_c(legend.text=element_text(size = 10)) +
viridis::scale_fill_viridis(discrete=TRUE,
option = "rocket", begin=.3,end=.8) +
labs(x = "Value",
y = "Probability Density",
title = latex2exp::TeX("Definition of Prior for $P(S_1|untested)$"),
fill ='',
subtitle = paste0("Mean: ", prior_params$s_untested_mean,
", SD: ", prior_params$s_untested_sd))
\(P(S_0| \text{test}_+, \text{untested})\)
tibble(x = seq(0, 1, length = 10^(5)),
y = with(prior_params, beta_density(x,
mean = p_s0_pos_mean,
sd = p_s0_pos_sd,
bounds = p_s0_pos_bounds))) %>%
ggplot(aes(x=x, y = y)) +
geom_line(alpha = .8) +
geom_ribbon(aes(x=x,ymin=0,ymax=y),
fill="black",
alpha=.6) +
theme_c(legend.text=element_text(size = 10)) +
viridis::scale_fill_viridis(discrete=TRUE,
option = "rocket", begin=.3,end=.8) +
labs(x = "Value",
y = "Probability Density",
title = latex2exp::TeX("Definition of Prior for $P(S_0|test_+,untested)$"),
fill ='',
subtitle = paste0("Mean: ", prior_params$p_s0_pos_mean,
", SD: ", prior_params$p_s0_pos_sd))
COVID-19 Trends and Impact Survey
ctis_smoothed <- tar_read(ctis_smoothed,store = here("_targets"))\(\beta\)
ctis_smoothed %>%
filter(keep) %>%
mutate(state=toupper(state)) %>%
select(date,
state,
imputed_beta,
beta_estimate_smoothed,
beta_estimate_spline_smoothed) %>%
pivot_longer(contains("beta")) %>%
mutate(name = case_when(
name == "beta_estimate_smoothed" ~ "LOESS smoothed",
name == "beta_estimate_spline_smoothed" ~ "Spline smoothed",
name == "imputed_beta" ~ "Survey Value"
)) %>%
ggplot(aes(x=date, y=value, color = name,
alpha = name, linewidth=name)) +
geom_line() +
facet_wrap(~state, ncol=4) +
scale_alpha_manual(values=c("LOESS smoothed" = .9,
"Spline smoothed" = .9,
"Survey Value"=.3),
name='') +
scale_linewidth_manual(values = c("LOESS smoothed" = 1.05,
"Spline smoothed" = 1.05,
"Survey Value"=.5)) +
scale_color_manual(values=c("#3381FF", "#B58746", "#26900F"),
name ='') +
guides(alpha="none",
linewidth="none",
color = guide_legend(override.aes = list(linewidth = 3,
alpha = c("LOESS smoothed" = .9,
"Spline smoothed" = .9,
"Survey Value"=.3)),
nrow=3)) +
theme_c(legend.position="top") +
ylim(0,1) +
scale_x_date(date_breaks="3 months",
date_labels = "%b %Y") +
labs(y = TeX("Survey Estimate of $\\beta$"),
x= "",
title = TeX("Comparing Approaches for Smoothing Survey Estimates of $\\beta$"))
The ratio of the screening test positivity over the overall test positivity from the COVID-19 Trends and Impact Survey is taken to be the estimate of \(\beta\). We compare two approaches to smoothing: cubic spline smoothing with 2 knots (July 15th, 2021 and December 1st, 2021) to LOESS smoothing with a span of 0.33.
\(\Pr(S_1 | \text{untested})\)
ctis_smoothed %>%
mutate(state=toupper(state)) %>%
select(date,
state,
contains("s_untested")) %>%
pivot_longer(contains("s_untested")) %>%
mutate(name = case_when(
name == "s_untested_smoothed" ~ "LOESS smoothed",
name == "imputed_s_untested" ~ "Survey Value"
)) %>%
ggplot(aes(x=date, y=value, color = name,
alpha = name, linewidth=name)) +
geom_line() +
facet_wrap(~state, ncol=5) +
scale_alpha_manual(values=c("LOESS smoothed" = .9,
"Survey Value"=.6),
name='') +
scale_linewidth_manual(values = c("LOESS smoothed" = 1.02,
"Survey Value"=.9)) +
scale_color_manual(values=c("Survey Value" ="black", "LOESS smoothed"="darkred"),
name ='') +
guides(alpha="none",
linewidth="none",
color = guide_legend(override.aes = list(
linewidth = 3,
alpha = c("LOESS smoothed" = .9,
"Survey Value"=.3)),
nrow=3)) +
theme_c(legend.position="top") +
scale_x_date(date_breaks="3 months",
date_labels = "%b %Y") +
labs(y = TeX("Survey Estimate of $Pr(S_1|untested)$"),
x= "",
title = TeX("Comparing Approaches for Smoothing Survey Estimates of $Pr(S_1|untested)$"))
The percentage of the population experiencing COVID-19-like illness is taken to be the estimate of $(S_1|). The LOESS smoothed estimate with a span of 0.2 is shown in red.